Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Const DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'the actual text to scroll. This could also be loaded in from a text file
Const ScrollText As String = "My Application Title" & vbCrLf & _
vbCrLf & vbCrLf & _
"Producer: Myself" & vbCrLf & _
"Executive Producer: Myself" & _
vbCrLf & "Main programmer: Myself" & _
vbCrLf & "Main graphic artist: Myself" & _
vbCrLf & vbCrLf & _
"Sample from:" & _
vbCrLf & _
"HTTP://WWW.VBEXPLORER.COM"
Dim EndingFlag As Boolean
Private Sub Form_Activate()
RunMain
End Sub
Private Sub Form_Load()
picScroll.ForeColor = vbYellow
picScroll.FontSize = 14
End Sub
Private Sub RunMain()
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long
'show the form
frmAbout.Refresh
'Get the size of the drawing rectangle by suppying the DT_CALCRECT constant
(.txt)